home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / INT24.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-19  |  8KB  |  224 lines
  1.  
  2. { Thanks to Marshall Brain for the original code for this routine.
  3.   Thanks to John Cooper for pointing out a small flaw in the code.
  4.  
  5.  
  6.   These routines provide a method for Turbo Pascal programs to trap MS-DOS
  7. interrupt 24 (hex).  INT 24 is called by DOS when a 'critical error' occurs,
  8. and it normally prints the familiar "Abort, Retry, Ignore?" message.
  9.  
  10.   With the INT 24 handler installed, errors of this type will be passed on to
  11. Turbo Pascal as an error.  If I/O checking is on, this will cause a program
  12. crash.  If I/O checking is off, IOResult will return an error code.  The
  13. global variable INT24Err will be true if an INT 24 error has occurred.  The
  14. variable INT24ErrorCode will contain the INT 24 error code as given by DOS.
  15. These errors can be found in the DOS Technical Reference Manual.  They
  16. correspond to the error codes returned by the function INT24Result, with a
  17. divisor of 256.  INT24Result is used like IOResult, and calls IOResult.  It
  18. then checks INT24Err, and if it is true, returns INT24ErrorCode*256 instead.
  19.  
  20.   In most cases, INT24Result should be used, because it does extra cleanup
  21. (sets INT24Err back to false, and restores the INT 24 handler, since DOS
  22. seems to sometimes reset the INT 24 vector after an error).
  23.  
  24.  
  25.   These routines are known to work correctly with: Turbo Pascal 2.00B PC-DOS;
  26.                                                    Turbo Pascal 2.00B MS-DOS.
  27.  
  28.  
  29.   Note that Turbo's normal IOResult codes for MS-DOS DO NOT correspond to the
  30. I/O error numbers given in Appendix I of the Turbo Pascal manual, or to the
  31. error codes given in the I/O error nn, PC=aaaa/Program aborted message.  Here
  32. is a table of the correspondence (all numbers in hexadecimal):
  33.  
  34.   IOResult    Turbo error
  35.   --------    -------------------------------------------------
  36.      00          00  none
  37.      01          90  record length mismatch
  38.      02          01  file does not exist
  39.      03          F1  directory is full
  40.      04          FF  file disappeared
  41.      05          02  file not open for input
  42.      06          03  file not open for output
  43.      07          99  unexpected end of file
  44.      08          F0  disk write error
  45.      09          10  error in numeric format
  46.      0A          99  unexpected end of file
  47.      0B          F2  file size overflow
  48.      0C          99  unexpected end of file
  49.      0D          F0  disk write error
  50.      0E          91  seek beyond end of file
  51.      0F          04  file not open
  52.      10          20  operation not allowed on a logical device
  53.      11          21  not allowed in direct mode
  54.      12          22  assign to standard files is not allowed
  55.  
  56.   -  Bela Lubkin
  57.      Borland International Technical Support
  58.      CompuServe 71016,1573
  59. }
  60.  
  61. Const
  62.   INT24Err: Boolean=False;
  63.   INT24ErrCode: Byte=0;
  64.   OldINT24: Array [1..2] Of Integer=(0,0);
  65.  
  66. Var
  67.   RegisterSet: Record Case Integer Of
  68.                  1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  69.                  2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  70.                End;
  71.  
  72. Procedure INT24;
  73.   Begin
  74.     { To understand this routine, you will need to read
  75.       the description on Interrupt 24 in the DOS manual.
  76.       It also helps to examine the generated code under DEBUG. }
  77.     Inline
  78.      ($2E/$C6/$06/ INT24Err /$01/$89/$EC/$83/$C4/$08/$89/$F8/$2E/$A2/
  79.       INT24ErrCode /$58/$B0/$FF/$5B/$59/$5A/$5E/$5F/$5D/$1F/$07/$CF);
  80.     { Turbo:  PUSH BP                    (Save caller's stack frame
  81.               MOV  BP,SP                   Set up this procedure's stack frame
  82.               PUSH BP                     ?)
  83.       Inline: MOV  BYTE CS:[INT24Err],1  Set INT24Err to True
  84.               MOV  SP,BP                 Get correct SP;  ADD: Discard saved
  85.               ADD  SP,8                    BP, INT 24 return address & flags
  86.               MOV  AX,DI                 Get INT 24 error code
  87.               MOV  CS:[INT24ErrCode],AL  Save it in INT24ErrCode
  88.               POP  AX                    Pop all registers
  89.               MOV  AL,0FFH               Set FCB call error flag:
  90.               POP  BX                      will cause Turbo I/O error on file
  91.               POP  CX                      operations, no error on character
  92.               POP  DX                      operations
  93.               POP  SI
  94.               POP  DI
  95.               POP  BP
  96.               POP  DS
  97.               POP  ES
  98.               IRET                       Return to next instruction }
  99.   End;
  100.  
  101. Procedure INT24On;  { Enable INT 24 trapping }
  102.   Begin
  103.     INT24Err:=False;
  104.     With RegisterSet Do
  105.      Begin
  106.       AX:=$3524;
  107.       MsDos(RegisterSet);
  108.       If (OldINT24[1] Or OldINT24[2])=0 Then
  109.        Begin
  110.         OldINT24[1]:=ES;
  111.         OldINT24[2]:=BX;
  112.        End;
  113.       DS:=CSeg;
  114.       DX:=Ofs(INT24);
  115.       AX:=$2524;
  116.       MsDos(RegisterSet);
  117.      End;
  118.   End;
  119.  
  120. Procedure INT24Off;  { Disable INT 24 trapping.  Should be done at the end
  121.                        of the program, if you plan to run the program from
  122.                        within the Turbo compiler.  If the INT 24 handler is
  123.                        left in place, and the compiler gets a critical
  124.                        error, the system is likely to crash. }
  125.   Begin
  126.     INT24Err:=False;
  127.     If OldINT24[1]<>0 Then
  128.       With RegisterSet Do
  129.        Begin
  130.         DS:=OldINT24[1];
  131.         DX:=OldINT24[2];
  132.         AX:=$2524;
  133.         MsDos(RegisterSet);
  134.        End;
  135.     OldINT24[1]:=0;
  136.     OldINT24[2]:=0;
  137.   End;
  138.  
  139. Function INT24Result: Integer;
  140.   Var
  141.     I:Integer;
  142.  
  143.   Begin
  144.     I:=IOResult;
  145.     If INT24Err Then
  146.      Begin
  147.       I:=I+256*INT24ErrCode;
  148.       INT24On;
  149.      End;
  150.     INT24Result:=I;
  151.   End;
  152. { INT24Result returns all the regular Turbo IOResult codes if no critical
  153.   error has occurred.  If a critical error, then the following values are
  154.   added to the error code from Turbo (each is 256 times the INT24ErrorCode
  155.   value returned by DOS):
  156.    256:  Attempt to write on write protected disk
  157.    512:  Unknown unit                 [internal dos error]
  158.    768:  Drive not ready              [drive door open or bad drive]
  159.    1024: Unknown command              [internal dos error]
  160.    1280: Data error (CRC)             [bad sector or drive]
  161.    1536: Bad request structure length [internal dos error]
  162.    1792: Seek error                   [bad disk or drive]
  163.    2048: Unknown media type           [bad disk or drive]
  164.    2304: Sector not found             [bad disk or drive]
  165.    2560: Printer out of paper         [anything that the printer might signal]
  166.    2816: Write fault                  [character device not ready]
  167.    3072: Read fault                   [character device not ready]
  168.    3328: General failure              [several meanings]
  169.  
  170.   If you need the IOResult part, use
  171.    I:=INT24Result and 255; [masks out the INT 24 code]
  172.  
  173.   For the INT 24 code, use
  174.    I:=INT24Result Shr 8;   [same as Div 256, except faster]
  175.  
  176.   INT24Result clears both error codes, so you must assign it to a variable if
  177.   you want to extract both codes:
  178.    J:=INT24Result;
  179.    WriteLn('Turbo IOResult  = ',J And 255);
  180.    WriteLn('DOS INT 24 code = ',J Shr 8);
  181.  
  182.   Note that in most cases, errors on character devices (LST and AUX) will not
  183.   return an IOResult, only an INT 24 error code. }
  184.  
  185. { Main program.  Delete next line to enable }
  186. (*
  187.  
  188. { Run this with printer off (or no printer), and nothing in drive A }
  189.  
  190. Var
  191.   F: File;
  192.   I: Integer;
  193.  
  194. Procedure PrinterTest;
  195.   Begin
  196.     WriteLn(LST,'test');
  197.     I:=INT24Result;
  198.     If I<>0 Then WriteLn('Printer error: ',I)
  199.     Else WriteLn('Printer OK');
  200.   End;
  201.  
  202. Procedure FileTest;
  203.   Begin
  204.     Assign(F,'A:FILE');
  205.     {$I-} Reset(F); {$I+}
  206.     I:=INT24Result;
  207.     If I<>0 Then WriteLn('Open failure on A:FILE :  INT24Result=',I)
  208.     Else WriteLn('A:FILE exists');
  209.     Close(F);
  210.   End;
  211.  
  212. Begin
  213.   INT24On;
  214.   PrinterTest;
  215.   FileTest;
  216.   PrinterTest;
  217.   INT24Off;
  218.   FileTest;
  219.   PrinterTest;
  220. End.
  221. (**)
  222.  
  223.  
  224.